バグトラッキングシステム(以降、BTS)のチケットデータには様々な情報が記録されており品質分析に使わない手はありません。バグチケットの分析は個々のチケットに対する定性分析を行うことが多いですが、定量分析の面から考えるとバグチケット自体はカテゴリカルデータの塊ですのでODC分析のようにクロス集計を用いる方法が考えられます。ODC分析ではODC分析用のタグに基づいた分析を行いますが、ここではバグチケットにある基本的な情報(項目)を用いた可視化の方法を探って行きます。
なお、本ページではR version 3.4.4 (2018-03-15)の標準パッケージ以外に以下の追加パッケージを用いています。
| Package | Version | Description |
|---|---|---|
| tidyverse | 1.2.1 | Easily Install and Load the ‘Tidyverse’ |
また、本ページでは以下のデータセットを用いています。
| Dataset | Package | Version | Description |
|---|---|---|---|
| redmine | N/A | N/A | Redmine Issues |
バグチケットはRedmine が公開しているRedmine自体のバグチケットを用います。RedmineはGPL v2ライセンスの下で提供されているオープンソースのプロジェクト管理ソフトウェアです。上表のリンク先でチケットを公開していますが、一度に50レコードまでしかダウンロードできないため事前にこちらで取得したレコードをデータフレーム形式にまとめたものを利用しています。なお、Redmine はREST APIを提供しておりJSON形式でチケット情報取得が可能ですが、REST APIは一度に25件しかチケット情報を取得できない点に注意してください。
前述のように今回は事前に整理したデータフレーム形式のチケット情報を用いますが、実際にはBTSのAPI機能やBTSのDBMSから直接データを取得することをおすゝめします。直接取得できない場合は、今回のようにCSVファイルへエクスポートするなどの方法を取ってください。
今回用いるRedmineのバグチケットの項目を簡単に説明してます。基本的な項目のみが用意されています。実際は因子型になっている項目をここでは文字型として扱っている点に注意してください。
| 項目 | 概要 | データ型 |
|---|---|---|
| # | 識別番号(Primary Key) | 整数型 |
| プロジェクト | 属するプロジェクト | 文字型(因子型) |
| トラッカー | 大分類 | 文字型(因子型) |
| 親チケット | 親子関係を定義したい場合に用いる | 文字型 |
| ステータス | 対応状況 | 文字型(因子型) |
| 優先度 | 対応優先度 | 文字型(因子型) |
| 題名 | タイトル | 文字型 |
| 作成者 | 作成者 | 文字型(因子型) |
| 担当者 | 対応担当者 | 文字型(因子型) |
| 更新日 | 更新日時 | 日時型(POSIXct) |
| カテゴリ | 分類(任意に利用設定できる) | 文字型(因子型) |
| 対象バージョン | チケット対処したバージョン | 文字型 |
| 開始日 | 対応を開始した日 | 日付型 |
| 期日 | 対応予定期間 | 日付型 |
| 予定工数 | 対応予定工数 | 数値型 |
| 進捗率 | 対応の進捗率 | 数値型(%表記) |
| 作成日 | 作成日時 | 日時型(POSIXct) |
| 終了日 | 対応完了日時 | 日時型(POSIXct) |
| 関連するチケット | 関係するチケット番号 | 文字型 |
| Resolution | 解決結果(非標準) | 文字型(因子型) |
| Affected version | 影響のあるバージョン | 文字型 |
| 説明 | 詳細 | 文字型 |
実際のデータは以下のような四千レコード弱のデータです。
(redmine <- "./data/redmine.csv" %>%
readr::read_csv(local = locale(encoding = "UTF-8")))
分析に必要な前処理を行っておきます。作成日と終了日のデータは実際は日時データになっていますので日データに変換して、必要な項目のみを抽出しておきます。
(x <- redmine %>%
dplyr::select(no = `#`, tracker = `トラッカー`, status = `ステータス`,
priority = `優先度`, category = `カテゴリ`,
version = `対象バージョン`, affected = `Affected version`,
open = `作成日`, close = `終了日`, subject = `題名`,
assignee = `担当者`) %>%
dplyr::mutate(open = lubridate::date(open), close = lubridate::date(close)))
データの概要は以下の通りです。
summary(x)
no tracker status priority
Min. :13710 Length:3826 Length:3826 Length:3826
1st Qu.:16723 Class :character Class :character Class :character
Median :20347 Mode :character Mode :character Mode :character
Mean :20647
3rd Qu.:24342
Max. :28967
category version affected
Length:3826 Length:3826 Length:3826
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
open close subject
Min. :2013-04-08 Min. :2010-07-19 Length:3826
1st Qu.:2014-04-19 1st Qu.:2014-07-21 Class :character
Median :2015-07-16 Median :2015-08-31 Mode :character
Mean :2015-08-17 Mean :2015-09-10
3rd Qu.:2016-11-13 3rd Qu.:2016-11-18
Max. :2018-06-06 Max. :2018-06-06
NA's :870
assignee
Length:3826
Class :character
Mode :character
データフレームに対する集計を行うにはdplyr::group_by関数+dplyr::summarise関数またはdplyr::count関数を用いるのが便利です。
なお、以下の二つのコードは共にdataに含まれるkey変数の水準毎に個数を数えるもので結果は等価になります。
dplyr::group_by(data, key) %>%
dplyr::summarise(n = n())
dplyr::count(data, kye)
単純集計は一つの変数に対して集計を行います。
x %>%
dplyr::count(tracker)
x %>%
dplyr::count(status)
x %>% dplyr::count(priority)
x %>%
dplyr::count(category)
x %>%
dplyr::count(version)
x %>%
dplyr::count(affected)
x %>%
dplyr::count(open)
単純集計では見えにくい傾向はクロス集計を行いことで見えてくることもあります。クロス集計はdplyr::count関数またはdplyr::group_by関数に複数の変数を指定し、tidyr::spread関数で変形することで簡単にクロス集計表が作成できます。
dplyr::count(x, key1, key2) %>%
tidyr::spread(key = key1, value = n)
x %>%
dplyr::count(tracker, status) %>%
tidyr::spread(key = tracker, value = n)
大半のチケットがステータスがClosedな対応が完了しているチケットですので、Closedを除くチケットに対する優先度を見て見ます。
x %>%
dplyr::filter(status != "Closed") %>%
dplyr::count(tracker, priority) %>%
tidyr::spread(key = tracker, value = n)
x %>%
dplyr::filter(status != "Closed" & tracker == "Defect") %>%
dplyr::count(priority, status) %>%
tidyr::spread(key = priority, value = n)
x %>%
dplyr::filter(status != "Closed" & tracker == "Patch") %>%
dplyr::count(priority, status) %>%
tidyr::spread(key = priority, value = n)
クロス集計の結果優先度がUrgentであるチケットがあることが分かりましたので、対象が何かを表示させてみます。クロス集計で検索条件が分かっていますので絞り込むだけです。
x %>%
dplyr::filter(status != "Closed" & tracker == "Defect") %>%
dplyr::filter(priority == "Urgent") %>%
dplyr::select(no, tracker, status, subject, assignee)
x %>%
dplyr::filter(status != "Closed" & tracker == "Defect") %>%
dplyr::count(category, priority) %>%
tidyr::spread(key = priority, value = n)
x %>%
dplyr::filter(status != "Closed" & tracker == "Defect") %>%
dplyr::count(priority, assignee) %>%
tidyr::spread(key = priority, value = n)
このデータではUrgentなチケットに担当者が割り当てられていないことが分かります。
ある一定期間ごとに集計する場合は日時データを日、週、月、四半期、年などに変換し変換後のデータをdplyr::count関数で集計することで期間の変化を確認できるようになります。
日次で集計する場合は日時の場合はlubridate::date関数で日付に変換しておきます。データがない日は集計対象外となります。稼働が発生していてデータがないのか、稼働が発生していないからデータがないのかで意味が変わってきますので集計の際には注意してください。
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(open) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(open) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前日との差` = ticket - dplyr::lag(ticket))
“週”を求めるにはlubridate::week関数を用います。ただし、lubridate::week関数は1から53までの値しか返しませんので、年をまたぐ際はlubridate::year関数などを用いて年の識別ができるようにしてください。
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(week = lubridate::week(open)) %>%
dplyr::filter(!is.na(week)) %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(week) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(week) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前週との差` = ticket - dplyr::lag(ticket))
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(week = lubridate::week(close)) %>%
dplyr::filter(!is.na(week)) %>%
dplyr::mutate(flag = ifelse(is.na(close), 0, 1)) %>%
dplyr::group_by(week) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(week) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前週との差` = ticket - dplyr::lag(ticket))
“月”を求めるにはlubridate::month関数を用います。ただし、lubridate::month関数は1から12までの値しか返しませんので、年をまたぐ際はlubridate::year関数などを用いて年の識別ができるようにしてください。
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(month = lubridate::month(open)) %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(month) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(month) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前月との差` = ticket - dplyr::lag(ticket))
“四半期”を求めるにはlubridate::quarter関数を用います。年をまたぐ際はwith_yearオプションを使用すると年の識別ができるようになります。また、第一四半期が1月以外から始まる場合はfiscal_startオプションを使用してください。
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::mutate(quarter = lubridate::quarter(open, with_year = TRUE,
fiscal_start = 1)) %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(quarter) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(quarter) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前四半期との差` = ticket - dplyr::lag(ticket))
“年”を求めるにはlubridate::year関数を用います。
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::mutate(year = lubridate::year(open)) %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(year) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(year) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前年との差` = ticket - dplyr::lag(ticket))
可視化にグラフを用いると変化や差異が把握しやすくなりますので分析の目的にあったグラフを持ちいることが大切です。
分布を可視化する代表的な方法としてはヒストグラム、箱ひげ図などがあります。
2018年のチケットが優先度ごとにどれだけ期間滞留しているかを可視化してみます。分布を把握したい場合はヒストグラム、分布範囲を把握した場合は箱ひげ図が便利です。
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(status != "Closed") %>%
dplyr::mutate(days = lubridate::today() - open + 1) %>%
dplyr::group_by(priority) %>%
dplyr::summarise(min = min(days), med = median(days), max = max(days))
x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(status != "Closed") %>%
dplyr::mutate(days = lubridate::today() - open + 1) %>%
ggplot2::ggplot(ggplot2::aes(x = days, fill = priority)) +
ggplot2::geom_histogram(alpha = 0.5, position = "identity")

x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(status != "Closed") %>%
dplyr::mutate(days = lubridate::today() - open + 1) %>%
ggplot2::ggplot(ggplot2::aes(x = priority, y = days, colour = priority)) +
ggplot2::geom_boxplot() +
ggplot2::geom_jitter() +
ggplot2::coord_flip()

同様にカテゴリごとの滞留期間を可視化してみます。
x %>%
dplyr::filter(open >= "2018-1-1") %>%
dplyr::filter(status != "Closed") %>%
dplyr::mutate(days = lubridate::today() - open + 1) %>%
dplyr::group_by(category) %>%
dplyr::summarise(min = min(days), med = median(days), max = max(days),
mode = which.max(table(days)))
x %>%
dplyr::filter(open >= "2018-1-1") %>%
dplyr::filter(status != "Closed") %>%
dplyr::mutate(days = lubridate::today() - open + 1) %>%
ggplot2::ggplot(ggplot2::aes(x = category, y = days)) +
ggplot2::geom_boxplot()

カテゴリごとのチケット対処期間(開始日から終了日までの期間)を可視化してみます。
x %>%
dplyr::filter(status == "Closed") %>%
dplyr::mutate(days = close - open + 1) %>%
dplyr::group_by(category) %>%
dplyr::summarise(min = min(days), med = median(days), max = max(days),
mode = which.max(table(days)))
x %>%
dplyr::filter(status == "Closed") %>%
dplyr::mutate(days = close - open + 1) %>%
ggplot2::ggplot(ggplot2::aes(x = category, y = days)) +
ggplot2::geom_boxplot()

集計結果の比率(割合)を可視化する方法としては棒グラフ、円グラフ、およびそれらの層別グラフなどがあります。層別するメリットは因子の水準ごとの違いの有無が把握できるようになることです。
x %>%
dplyr::filter(status != "Closed" & tracker == "Defect") %>%
dplyr::mutate(year = lubridate::year(open)) %>%
ggplot2::ggplot(ggplot2::aes(x = priority, fill = category)) +
ggplot2::geom_bar(alpha = 0.5) +
ggplot2::facet_wrap(~ year)

x %>%
dplyr::filter(status == "Closed" & tracker == "Defect") %>%
dplyr::mutate(year = lubridate::year(close)) %>%
ggplot2::ggplot(ggplot2::aes(x = priority, fill = category)) +
ggplot2::geom_bar(alpha = 0.5) +
ggplot2::facet_wrap(~ year)

比率の可視化に利用する棒グラフも時系列で層別に描くと推移もみえるようになります。例えば、バージョンごとのチケットの完了状況をチケット起票年ごとに分けて表示することで過去バグと最近のバグの発生状況が俯瞰できるようになります。
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::mutate(flag = ifelse(status == "Closed", "Closed", "Open")) %>%
dplyr::mutate(year = lubridate::year(open)) %>%
dplyr::filter(!is.na(affected)) %>%
ggplot2::ggplot(ggplot2::aes(x = affected, fill = flag)) +
ggplot2::geom_bar(alpha = 0.75) +
ggplot2::facet_wrap(~ year)

(主に時系列の)推移を可視化する代表的な方法としては折れ線グラフ、棒グラフ、ヒートマップがあります。
棒グラフを用いると時系列による比率の変化がみえるようになります。
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::mutate(quarter = lubridate::quarter(close, with_year = TRUE,
fiscal_start = 1)) %>%
dplyr::mutate(flag = ifelse(is.na(close), 0, 1)) %>%
dplyr::group_by(quarter, priority) %>%
dplyr::summarise(ticket = sum(flag)) %>%
dplyr::arrange(quarter) %>%
dplyr::filter(!is.na(quarter)) %>%
dplyr::mutate(`累計` = cumsum(ticket),
`前四半期との差` = ticket - dplyr::lag(ticket)) %>%
ggplot2::ggplot(ggplot2::aes(x = as.character(quarter))) +
ggplot2::geom_bar(ggplot2::aes(y = ticket, fill = priority),
stat = "identity", alpha = 0.5) +
ggplot2::labs(x = "", y = "Number of 'Closed' Defect Ticket",
title = "四半期ごとの完了バグチケット数の推移")

前出の週次集計を可視化してみます。加えて平均起票数を基準として前週との起票数の差を折れ線グラフで表示しています。
open <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(week = lubridate::week(open)) %>%
dplyr::filter(!is.na(week))
close <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(close >= "2018-1-1") %>%
dplyr::mutate(week = lubridate::week(close)) %>%
dplyr::filter(!is.na(week))
df_week <-
seq(ifelse(min(open$week) <= min(close$week), min(open$week), min(close$week)),
ifelse(max(open$week) >= max(close$week), max(open$week), max(close$week)),
by = 1) %>% as.data.frame()
names(df_week) <- c("week")
open <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::mutate(week = lubridate::week(open)) %>%
dplyr::filter(!is.na(week))
open <- df_week %>%
dplyr::left_join(open, by = "week") %>%
dplyr::mutate(flag = ifelse(is.na(open), 0, 1)) %>%
dplyr::group_by(week) %>%
dplyr::summarise(open = sum(flag)) %>%
dplyr::arrange(week) %>%
dplyr::mutate(cumopen = cumsum(open), diff = open - dplyr::lag(open))
open %>%
dplyr::rename(`週` = week, `チケットオープン数` = open, `累計` = cumopen,
`前週との差` = diff)
open %>%
dplyr::mutate(diff_offset = diff + round(mean(open, na.rm = TRUE))) %>%
ggplot2::ggplot(ggplot2::aes(x = week)) +
ggplot2::geom_bar(ggplot2::aes(y = open), stat = "identity", alpha = 0.25) +
ggplot2::geom_hline(yintercept = round(mean(open$open, na.rm = TRUE), 1),
colour = "#00bfc4", linetype = "dashed") +
ggplot2::geom_line(ggplot2::aes(y = diff_offset), colour = "#00bfc4",
size = 0.75)

ここではチケット数のみグラフにしていますが、試験実施数を試験種別などで色分けした棒グラフなどを重ね合わせることで実施に対してどれだけのバグが摘出できているかがみえてくるようになる可能性があります。
同様に対処が完了したチケット数をグラフにしてみます。
close <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(close >= "2018-1-1") %>%
dplyr::mutate(week = lubridate::week(close)) %>%
dplyr::filter(!is.na(week))
close <- df_week %>%
dplyr::left_join(close, by = "week") %>%
dplyr::mutate(flag = ifelse(is.na(close), 0, 1)) %>%
dplyr::group_by(week) %>%
dplyr::summarise(close = sum(flag)) %>%
dplyr::arrange(week) %>%
dplyr::mutate(cumclose = cumsum(close), diff = close -dplyr::lag(close))
close %>%
dplyr::rename(`週` = week, `チケットクローズ数` = close, `累計` = cumclose,
`前週との差` = diff)
close %>%
dplyr::mutate(diff_offset = diff + round(mean(close, na.rm = TRUE)), 1) %>%
ggplot2::ggplot(ggplot2::aes(x = week)) +
ggplot2::geom_bar(ggplot2::aes(y = close), stat = "identity", alpha = 0.25) +
ggplot2::geom_hline(yintercept = round(mean(close$close, na.rm = TRUE)),
colour = "#f8766d", linetype = "dashed") +
ggplot2::geom_line(ggplot2::aes(y = diff_offset), colour = "#f8766d",
size = 0.75)

チケットのオープン数と比べるとクローズ数の方がかなり低調に見えます。
前出の週次の集計から累計データに着目したものがオープン・クローズチャートです。オープン・クローズチャートはチケットの対応状況が一目で分かるグラフです。
week_ticket <- open %>%
dplyr::full_join(close, by = "week") %>%
dplyr::select(week, open, close) %>%
tidyr::gather(key, value, -week)
open %>%
dplyr::full_join(close, by = "week") %>%
dplyr::select(week, cumopen, cumclose) %>%
tidyr::gather(key, value, -week) %>%
dplyr::left_join(week_ticket, by = "week") %>%
ggplot2::ggplot(ggplot2::aes(x = week)) +
ggplot2::geom_bar(ggplot2::aes(y = value.y, fill = key.y),
stat = "identity", alpha = 0.5, position = "dodge") +
ggplot2::geom_line(ggplot2::aes(y = value.x, colour = key.x),
stat = "identity", size = 0.75) +
ggplot2::scale_color_hue(name = "累計",
labels = c(cumclose = "Closed", cumopen = "Open")) +
ggplot2::scale_fill_hue(name = "週次",
labels = c(close = "Closed", open = "Open")) +
ggplot2::labs(y = "Number of Defect Ticket",
title = "週次のバグチケット数の推移")

個別にチャートを描いた場合に見えたようにクローズ傾向が低調なため処理が完了しないチケットが増えていることが分かります。
このグラフに試験項目数(計画、実績)のバーンダウンチャートを加えれば週次管理表になります。
日次の場合は試験稼働が発生していない日はチケット起票がゼロとは言えず、無稼働日を除かないとチャートが横に寝てしまい正しい傾向が掴めませんので注意してください。
open <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(!is.na(open))
close <- x %>%
dplyr::filter(open >= "2018-1-1" & tracker == "Defect") %>%
dplyr::filter(close >= "2018-1-1") %>%
dplyr::filter(!is.na(close))
start <- ifelse(range(open$open)[1] <= range(close$close)[1],
range(open$open)[1], range(close$close)[1]) %>%
lubridate::as_date()
end <- ifelse(range(open$open)[2] <= range(close$close)[2],
range(open$open)[2], range(close$close)[2]) %>%
lubridate::as_date()
df_days <-
seq(start, end, by = 1) %>% as.data.frame()
names(df_days) <- c("days")
open_ticket <- df_days %>%
dplyr::left_join(open, by = c("days" = "open")) %>%
dplyr::mutate(flag = ifelse(is.na(no), 0, 1)) %>%
dplyr::group_by(days) %>%
dplyr::summarise(open = sum(flag)) %>%
dplyr::arrange(days) %>%
dplyr::mutate(cumopen = cumsum(open))
close_ticket <- df_days %>%
dplyr::left_join(close, by = c("days" = "close")) %>%
dplyr::mutate(flag = ifelse(is.na(no), 0, 1)) %>%
dplyr::group_by(days) %>%
dplyr::summarise(close = sum(flag)) %>%
dplyr::arrange(days) %>%
dplyr::mutate(cumclose = cumsum(close))
bar_data <- open_ticket %>%
dplyr::left_join(close_ticket, by = "days") %>%
dplyr::select(days, open, close) %>%
tidyr::gather(key, value , -days)
line_data <- open_ticket %>%
dplyr::left_join(close_ticket, by = "days") %>%
dplyr::select(days, cumopen, cumclose) %>%
tidyr::gather(key, value , -days)
bar_data %>%
dplyr::left_join(line_data, by = "days") %>%
ggplot2::ggplot(ggplot2::aes(x = days)) +
ggplot2::geom_bar(ggplot2::aes(y = value.x, fill = key.x),
stat = "identity", alpha = 0.5, position = "dodge") +
ggplot2::geom_line(ggplot2::aes(y = value.y, colour = key.y),
stat = "identity", size = 0.75) +
ggplot2::scale_color_hue(name = "累計",
labels = c(cumclose = "Closed", cumopen = "Open")) +
ggplot2::scale_fill_hue(name = "日次",
labels = c(close = "Closed", open = "Open")) +
ggplot2::labs(y = "Number of Defect Ticket",
title = "日次のバグチケット数の推移")

推移を見るには前述のように折れ線グラフや棒グラフを利用することが多いですが、対象期間が長くなるとグラフが見難くなる場合があります。そんな時に便利なグラフがヒートマップです。数値の大小を色で表で表しますので、特にピークやボトムの推移を把握するのに向いています。
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::count(open) %>%
dplyr::mutate(year = lubridate::year(open), month = lubridate::month(open),
week = lubridate::week(open),
wday = lubridate::wday(open, label = TRUE),
mweek = week -
lubridate::week(lubridate::floor_date(open, "month")) + 1) %>%
ggplot2::ggplot(ggplot2::aes(x = mweek, y = wday, fill = n)) +
ggplot2::facet_grid(year ~ month) +
ggplot2::geom_tile() +
ggplot2::scale_fill_gradient(low = "gray", high = "red") +
ggplot2::labs(x = "", y = "") +
ggplot2::theme_bw()

各月の第何曜日にピークがあるかを見る場合には月内週数計算に注意が必要です。月内週数を計算する関数がないため、週番号から月初日の週番号を差し引いて月内週数を求める必要があります。しかし、週番号は様々な定義があるため定義を理解していないと意図した結果にならない場合があります。
| 関数 | 処理概要 | 備考 |
|---|---|---|
lubridate::week |
1月1日を基準に7日単位で週数を計算する | |
lubridate::isoweek |
ISO 8601にしたがって週数を計算する | 月曜開始 |
lubridate::epiweek |
epidemiological week | 日曜開始 |
特にカレンダーをイメージした月内週数を得たい場合にはlubridate::isoweek関数を使用してください。ただし、ISO 8601 の定義を理解しておく必要があります。
特に以下の点に注意してください。
月内週数は以下の計算で求められます。
\[指定日の週番号 - 月初日の週番号 + 1\]
Rで計算する場合はlubridateパッケージを用います。ISO 8601で計算されますので、上記の注意事項を考慮して以下のようなコードになります。xは月内週数を計算したい日(指定日)です。
lubridate::isoweek(x) - lubridate::isoweek(lubridate::floor_date(x), "month") + offset
offsetは以下のように条件により値が異なる点に注意してください。
| 条件 | offsetの値 | 備考 |
|---|---|---|
| 月初日の週番号が52週の場合 | 53 | |
| 月初日の週番号が53週の場合 | 54 | |
| 月初日の週番号が指定日の週番号より大きな場合 | 週番号 - 指定日の週番号 + 1 | |
| 上記以外 | 1 |
x %>%
dplyr::filter(tracker == "Defect") %>%
dplyr::select(date = open) %>%
dplyr::mutate(date = lubridate::as_date(date)) %>%
# ヒートマップに項目に応じて年、月、週、日、曜日などを求める
dplyr::mutate(year = lubridate::year(date), month = lubridate::month(date),
week = lubridate::isoweek(date), day = lubridate::day(date),
wday = lubridate::wday(date, label = TRUE, week_start = 1),
tweek = lubridate::isoweek(lubridate::floor_date(date, "month"))) %>%
# ISO 8601に特有の処理
dplyr::mutate(offset = ifelse(tweek == 53, 54, 1)) %>%
dplyr::mutate(offset = ifelse(tweek == 52, 53, offset)) %>%
dplyr::mutate(offset = ifelse(tweek > week, tweek - week + 1, offset)) %>%
# 例外処理
dplyr::mutate(offset = ifelse(tweek == week, 1, offset)) %>%
# 月内の週数を計算する
dplyr::mutate(mweek = week - tweek + offset) %>%
dplyr::count(mweek, wday) %>%
ggplot2::ggplot(ggplot2::aes(x = mweek, y = wday, fill = n)) +
ggplot2::geom_tile() +
ggplot2::scale_fill_gradient(low = "white", high = "red") +
ggplot2::labs(x = "", y = "曜日") +
ggplot2::theme_bw() + ggplot2::coord_flip()

dplyrパッケージでクロス集計に小計を加える場合は以下のコードを参考にしてください。Sum列が行方向(各列)の小計、statusのNA行が列方向(各行)の小計になります。
row_sum <- x %>%
dplyr::count(tracker, status) %>%
tidyr::spread(key = tracker, value = n) %>%
dplyr::mutate(Sum = ifelse(is.na(Defect), 0, Defect) +
ifelse(is.na(Patch), 0, Patch)) %>%
dplyr::summarise_if(is.numeric, sum, na.rm = TRUE) %>%
dplyr::mutate(status = NA) %>%
dplyr::select(status, Defect, Patch, Sum)
x %>%
dplyr::count(tracker, status) %>%
tidyr::spread(key = tracker, value = n) %>%
dplyr::mutate(Sum = ifelse(is.na(Defect), 0, Defect) +
ifelse(is.na(Patch), 0, Patch)) %>%
dplyr::bind_rows(row_sum)